home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 050 / bitmap2.pqs / BITMAP2.PAS
Encoding:
Pascal/Delphi Source File  |  1986-01-14  |  1.6 KB  |  64 lines
  1. PROGRAM bit_map2;
  2.  
  3. CONST
  4.   header = 'Test < Bit Mapping Routine >';
  5.  
  6. VAR
  7.   more,response : CHAR;
  8.   ans           : ARRAY[1..8] OF BOOLEAN;
  9.   hold          : BYTE;
  10.   i             : INTEGER;
  11.  
  12. PROCEDURE set_bits(VAR flag : BYTE; a,b,c,d,e,f,g,h : BOOLEAN);
  13. BEGIN
  14.   flag := 0;
  15.   IF a THEN flag := flag OR $80;
  16.   IF b THEN flag := flag OR $40;
  17.   IF c THEN flag := flag OR $20;
  18.   IF d THEN flag := flag OR $10;
  19.   IF e THEN flag := flag OR $08;
  20.   IF f THEN flag := flag OR $04;
  21.   IF g THEN flag := flag OR $02;
  22.   IF h THEN flag := flag OR $01
  23. END;
  24.  
  25. PROCEDURE get_bits(flag : BYTE; VAR a,b,c,d,e,f,g,h : BOOLEAN);
  26. BEGIN
  27.   a := (flag AND $80 <> 0);
  28.   b := (flag AND $40 <> 0);
  29.   c := (flag AND $20 <> 0);
  30.   d := (flag AND $10 <> 0);
  31.   e := (flag AND $08 <> 0);
  32.   f := (flag AND $04 <> 0);
  33.   g := (flag AND $02 <> 0);
  34.   h := (flag AND $01 <> 0)
  35. END;
  36.  
  37. PROCEDURE set_up_screen;
  38. BEGIN
  39.   CLRSCR; WRITELN; WRITELN(header); WRITELN;
  40. END;
  41.  
  42. BEGIN
  43.   REPEAT
  44.     set_up_screen;
  45.     FOR i := 1 TO 8 DO
  46.     BEGIN
  47.       WRITE('Question # ',i,' Answer Y/N : ');
  48.       READ(KBD,response); WRITELN(UPCASE(response));
  49.       ans[i] := (response IN ['Y','y'])
  50.     END;
  51.     set_bits(hold,ans[1],ans[2],ans[3],ans[4],ans[5],ans[6],ans[7],ans[8]);
  52.     get_bits(hold,ans[1],ans[2],ans[3],ans[4],ans[5],ans[6],ans[7],ans[8]);
  53.     WRITELN;
  54.     FOR i := 1 TO 8 DO
  55.     BEGIN
  56.       WRITE('Bit # ',i);
  57.       IF ans[i] = TRUE THEN WRITELN(' is true.') ELSE WRITELN(' is false.');
  58.     END;
  59.     WRITELN;
  60.     WRITE('The byte has a value of ',hold,'. Want to run it again ? ');
  61.     READ(KBD,more); more := UPCASE(more);
  62.   UNTIL more <> 'Y';
  63. END.
  64.